home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Grab Bag
/
Shareware Grab Bag.iso
/
001
/
pibt40s3.arc
/
PIBSCRN2.MOD
< prev
next >
Wrap
Text File
|
1987-04-09
|
41KB
|
772 lines
(*----------------------------------------------------------------------*)
(* Get_Screen_Text_Line --- Extract text from screen image *)
(*----------------------------------------------------------------------*)
PROCEDURE Get_Screen_Text_Line( VAR Text_Line : AnyStr;
Screen_Line : INTEGER;
Screen_Column : INTEGER );
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Get_Screen_Text_Line *)
(* *)
(* Purpose: Extracts text from current screen image *)
(* *)
(* Calling Sequence: *)
(* *)
(* Get_Screen_Text_Line( VAR Text_Line : AnyStr; *)
(* Screen_Line : INTEGER; *)
(* Screen_Column : INTEGER ); *)
(* *)
(* Text_Line --- receives text extracted from screen *)
(* Screen_Line --- line on screen to extract *)
(* Screen_Column --- starting column to extract *)
(* *)
(* Calls: None *)
(* *)
(* Remarks: *)
(* *)
(* Only the text -- not attributes -- from the screen is *)
(* returned. *)
(* *)
(*----------------------------------------------------------------------*)
VAR
First_Pos : INTEGER;
Len : INTEGER;
I : INTEGER;
J : INTEGER;
Regs : RegPack;
SaveX : INTEGER;
SaveY : INTEGER;
C : BYTE;
Attr : BYTE;
LBuffer : ARRAY[1..256] OF CHAR;
BEGIN (* Get_Screen_Text_Line *)
Screen_Line := Max( Min( Screen_Line , Max_Screen_Line ) , 1 );
Screen_Column := Max( Min( Screen_Column , Max_Screen_Col ) , 1 );
Text_Line[0] := #0;
IF Write_Screen_Memory THEN
BEGIN
First_Pos := ( ( Screen_Line - 1 ) * Max_Screen_Col +
Screen_Column ) SHL 1 - 1;
Len := Max_Screen_Col - Screen_Column + 1;
J := 0;
IF TimeSharingActive THEN
BEGIN
TurnOffTimeSharing;
Get_Screen_Address( Actual_Screen );
END;
IF Wait_For_Retrace THEN
MoveFromScreen( Actual_Screen^.Screen_Image[ First_Pos ],
LBuffer[1], Len )
ELSE
Move( Actual_Screen^.Screen_Image[ First_Pos ], LBuffer[1], Len SHL 1 );
I := 1;
FOR J := 1 TO Len DO
BEGIN
Text_Line[J] := LBuffer[I];
I := I + 2;
END;
Text_Line[0] := CHR( Len );
IF TimeSharingActive THEN
TurnOnTimeSharing;
END
ELSE
BEGIN (* Use BIOS to extract line *)
(* Save current position *)
SaveX := WhereX;
SaveY := WhereY;
J := 0;
(* Loop over columns to extract *)
FOR I := Screen_Column TO Max_Screen_Col DO
BEGIN
(* Pick up character *)
ReadCXY( C, I, Screen_Line, Attr );
(* Insert character in result string *)
J := SUCC( J );
Text_Line[J] := CHR ( C );
END;
(* Set length of string extracted *)
Text_Line[0] := CHR( J );
(* Restore previous position *)
GoToXY( SaveX, SaveY );
END;
END (* Get_Screen_Text_Line *);
(*----------------------------------------------------------------------*)
(* Print_Screen --- Print current screen image *)
(*----------------------------------------------------------------------*)
PROCEDURE Print_Screen;
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Print_Screen *)
(* *)
(* Purpose: Prints current screen image (memory mapped area) *)
(* *)
(* Calling Sequence: *)
(* *)
(* Print_Screen; *)
(* *)
(* Calls: None *)
(* *)
(* Remarks: *)
(* *)
(* Only the text from the screen is printed, not the attributes. *)
(* *)
(*----------------------------------------------------------------------*)
VAR
I : INTEGER;
Text_Line : AnyStr;
BEGIN (* Print_Screen *)
FOR I := 1 TO Max_Screen_Line DO
BEGIN
Get_Screen_Text_Line( Text_Line, I, 1 );
WRITELN( Lst , Text_Line );
END;
END (* Print_Screen *);
(*----------------------------------------------------------------------*)
(* Write_Screen --- Write current screen image to file *)
(*----------------------------------------------------------------------*)
PROCEDURE Write_Screen( Fname : AnyStr );
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Write_Screen *)
(* *)
(* Purpose: Write current screen image (memory mapped area) to *)
(* a file. *)
(* *)
(* Calling Sequence: *)
(* *)
(* Write_Screen( Fname : AnyStr ); *)
(* *)
(* Fname --- Name of file to write screen to *)
(* *)
(* Calls: Open_For_Append *)
(* *)
(* Remarks: *)
(* *)
(* Only the text from the screen is written, not the attributes. *)
(* If the file already exists, then the new screen is appended *)
(* to the end of the file. *)
(* *)
(*----------------------------------------------------------------------*)
VAR
I : INTEGER;
Text_Line : AnyStr;
F : Text_File;
BEGIN (* Write_Screen *)
IF Open_For_Append( F , Fname , I ) THEN
BEGIN
FOR I := 1 TO Max_Screen_Line DO
BEGIN
Get_Screen_Text_Line( Text_Line, I, 1 );
WRITELN( F , Text_Line );
END;
(*$I-*)
CLOSE( F );
(*$I+*)
END;
END (* Write_Screen *);
(*----------------------------------------------------------------------*)
(* Write_Graphics_Screen --- Write current screen image to file *)
(*----------------------------------------------------------------------*)
PROCEDURE Write_Graphics_Screen( Fname : AnyStr );
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Write_Graphics_Screen *)
(* *)
(* Purpose: Write current screen image (memory mapped area) to *)
(* a file. *)
(* *)
(* Calling Sequence: *)
(* *)
(* Write_Graphics_Screen( Fname : AnyStr ); *)
(* *)
(* Fname --- Name of file to write screen to *)
(* *)
(* Calls: None *)
(* *)
(* Remarks: *)
(* *)
(* If the file already exists, then the new screen is appended *)
(* to the end of the file. *)
(* *)
(*----------------------------------------------------------------------*)
VAR
I : INTEGER;
F : FILE;
BEGIN (* Write_Graphics_Screen *)
(*$I-*)
ASSIGN( F , Fname );
REWRITE( F , Graphics_Screen_Length );
(* Turn off timesharing while writing screen *)
IF ( MultiTasker = DoubleDos ) THEN
BEGIN
TurnOffTimeSharing;
Get_Screen_Address( Graphics_Screen );
END;
BlockWrite( F, Graphics_Screen^, 1 );
CLOSE( F );
(*$I+*)
(* Restore timesharing mode *)
IF ( MultiTasker = DoubleDos ) THEN
TurnOnTimeSharing;
END (* Write_Graphics_Screen *);
(*----------------------------------------------------------------------*)
(* Get_Screen_Size --- Get maximum rows, columns of display *)
(*----------------------------------------------------------------------*)
PROCEDURE Get_Screen_Size( VAR Rows: INTEGER; VAR Columns: INTEGER );
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Get_Screen_Size *)
(* *)
(* Purpose: Gets maximum rows, columns in current display *)
(* *)
(* Calling Sequence: *)
(* *)
(* Get_Screen_Size( VAR Rows: INTEGER; VAR Columns: INTEGER ); *)
(* *)
(* Rows --- # of rows in current display *)
(* Columns --- # of columns in current display *)
(* *)
(* Calls: Bios *)
(* *)
(*----------------------------------------------------------------------*)
VAR
Regs : RegPack;
I : INTEGER;
BEGIN (* Get_Screen_Size *)
(* Set defaults *)
Regs.AH := $0F;
INTR( $10 , Regs );
Rows := 25;
Columns := MAX( Regs.AH , 80 );
(* If EGA installed, check for other *)
(* line values. *)
IF EGA_Installed THEN
BEGIN
(* Get # of rows in current EGA display *)
Rows := Get_Rows_For_EGA;
(* If 25 lines returned, set *)
(* EGA 25-line mode to avoid cursor *)
(* problems later on, but only if *)
(* 80 column text mode. *)
IF ( ( Rows = 25 ) AND ( Columns = 80 ) ) THEN
BEGIN
(* Load font for 25 line mode *)
Regs.AX := $1111;
Regs.BL := 0;
INTR( $10, Regs );
(* Reset cursor for 25 line mode *)
Regs.CX := $0607;
Regs.AH := 01;
INTR( $10 , Regs );
END;
END;
END (* Get_Screen_Size *);
(*----------------------------------------------------------------------*)
(* Set_Screen_Size --- Get maximum rows, columns of display *)
(*----------------------------------------------------------------------*)
PROCEDURE Set_Screen_Size( Rows: INTEGER; Columns: INTEGER );
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Set_Screen_Size *)
(* *)
(* Purpose: Sets maximum rows, columns in Turbo run-time area *)
(* *)
(* Calling Sequence: *)
(* *)
(* Set_Screen_Size( Rows: INTEGER; Columns: INTEGER ); *)
(* *)
(* Rows --- # of rows in current display *)
(* Columns --- # of columns in current display *)
(* *)
(* Calls: Clone_Code_Segment *)
(* *)
(*----------------------------------------------------------------------*)
BEGIN (* Set_Screen_Size *)
Mem[CSeg:Turbo_Screen_Length] := Rows;
Mem[CSeg:Turbo_Screen_Width ] := Columns;
CloneCodeSegment( Turbo_Screen_Length , 1 );
CloneCodeSegment( Turbo_Screen_Width , 1 );
END (* Set_Screen_Size *);
(*----------------------------------------------------------------------*)
(* Set_EGA_Text_Mode --- Set character set, cursor for EGA *)
(*----------------------------------------------------------------------*)
PROCEDURE Set_EGA_Text_Mode( EGA_Rows : INTEGER );
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Set_EGA_Text_Mode *)
(* *)
(* Purpose: Set character set, cursor for EGA *)
(* *)
(* Calling Sequence: *)
(* *)
(* Set_EGA_Text_Mode( EGA_Rows : INTEGER ); *)
(* *)
(* Rows --- # of rows to set in current display *)
(* 25, 35, 43, and 50 lines are supported here. *)
(* *)
(*----------------------------------------------------------------------*)
(* STRUCTURED *) CONST
Table_Ofs : INTEGER = 0;
Table_Seg : INTEGER = 0;
BEGIN (* Set_EGA_Text_Mode *)
Table_Ofs := OFS( Sector_Data );
Table_Seg := SEG( Sector_Data );
INLINE(
$55 { PUSH BP}
/$1E { PUSH DS ;Save registers}
{;}
/$FC { CLD ; All strings forward}
{;}
/$8B/$86/>EGA_ROWS { MOV AX,[BP+>EGA_Rows] ; Pick up # lines}
/$3D/$19/$00 { CMP AX,25}
/$74/$0F { JE Line25}
/$3D/$23/$00 { CMP AX,35}
/$74/$14 { JE Line35}
/$3D/$2B/$00 { CMP AX,43}
/$74/$44 { JE Line43}
/$3D/$32/$00 { CMP AX,50}
/$74/$49 { JE Line50}
{; ; Assume 25 lines if bogus}
/$B8/$11/$11 {Line25: MOV AX,$1111 ; Load 8 x 14 font}
/$B3/$00 { MOV BL,0}
/$CD/$10 { INT $10}
/$E9/$6F/$00 { JMP Exit}
{;}
/$B8/$30/$11 {Line35: MOV AX,$1130 ; Load 8 x 8 font}
/$B7/$03 { MOV BH,3}
/$CD/$10 { INT $10}
/$06 { PUSH ES}
/$1F { POP DS}
/$89/$EE { MOV SI,BP ; DS:SI point to font}
/$2E/$C4/$3E/>TABLE_OFS{ CS: LES DI,[>Table_Ofs]}
/$BB/$00/$01 { MOV BX,$0100 ; Number of chars}
/$29/$C0 { SUB AX,AX}
{;}
/$B9/$04/$00 {Loop35: MOV CX,4 ; Bytes per char}
/$F3/$A5 { REPZ MOVSW}
/$AB { STOSW}
/$4B { DEC BX}
/$75/$F7 { JNZ Loop35}
/$2E/$A1/>TABLE_OFS { CS: MOV AX,[>Table_Ofs]}
/$89/$C5 { MOV BP,AX ; Points to font}
/$BA/$00/$00 { MOV DX,0 ; Starting char}
/$B9/$00/$01 { MOV CX,$0100 ; Number of chars}
/$BB/$00/$0A { MOV BX,$0A00 ; Bytes/char}
/$B8/$10/$11 { MOV AX,$1110 ; Load user font}
/$CD/$10 { INT $10}
/$E9/$3A/$00 { JMP Exit}
{;}
/$B8/$12/$11 {Line43: MOV AX,$1112 ; Load 8 x 8 font}
/$B3/$00 { MOV BL,0}
/$CD/$10 { INT $10}
/$E9/$30/$00 { JMP Exit}
{;}
/$B8/$30/$11 {Line50: MOV AX,$1130 ; Load 8 x 8 font}
/$B7/$03 { MOV BH,3}
/$CD/$10 { INT $10}
/$06 { PUSH ES}
/$1F { POP DS}
/$89/$EE { MOV SI,BP ; DS:SI point to font}
/$2E/$C4/$3E/>TABLE_OFS{ CS: LES DI,[>Table_Ofs]}
/$BB/$00/$01 { MOV BX,$0100 ; Number of chars}
{;}
/$B9/$07/$00 {Loop50: MOV CX,7 ; Bytes per char}
/$F3/$A4 { REPZ MOVSB}
/$46 { INC SI}
/$4B { DEC BX}
/$75/$F7 { JNZ Loop50}
/$2E/$A1/>TABLE_OFS { CS: MOV AX,[>Table_Ofs]}
/$89/$C5 { MOV BP,AX ; Points to font}
/$BA/$00/$00 { MOV DX,0 ; Starting char}
/$B9/$00/$01 { MOV CX,$0100 ; Number of chars}
/$BB/$00/$07 { MOV BX,$0700 ; Bytes/char, block load}
/$B8/$10/$11 { MOV AX,$1110 ; Load user font}
/$CD/$10 { INT $10}
{;}
/$1F {Exit: POP DS}
/$5D { POP BP}
);
CursorOn;
END (* Set_EGA_Text_Mode *);
(*----------------------------------------------------------------------*)
(* WriteSXY --- Write text string to specified row/column *)
(*----------------------------------------------------------------------*)
PROCEDURE WriteSXY (* ( S: AnyStr; X: INTEGER; Y: INTEGER; Color: INTEGER ) *);
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: WriteSXY *)
(* *)
(* Purpose: Writes text string at specified row and column *)
(* position on screen. *)
(* *)
(* Calling Sequence: *)
(* *)
(* WriteSXY( S: AnyStr; X: INTEGER; Y: INTEGER; Color: INTEGER );*)
(* *)
(* S --- String to be written *)
(* X --- Column position to write string *)
(* Y --- Column position to write string *)
(* Color --- Color in which to write string *)
(* *)
(* Calls: None *)
(* *)
(*----------------------------------------------------------------------*)
BEGIN (* WriteSXY *)
(* Freeze screen for DoubleDos *)
IF ( MultiTasker = DoubleDos ) THEN
BEGIN
TurnOffTimeSharing;
Get_Screen_Address( DesqView_Screen );
END;
INLINE(
$1E { PUSH DS ;Save data segment register}
{;}
{; Check if we're using BIOS.}
{;}
/$F6/$06/>WRITE_SCREEN_MEMORY/$01{ TEST BYTE [>Write_Screen_Memory],1 ;Direct screen write?}
/$74/$53 { JZ Bios ;No -- go use BIOS}
{;}
{; Set up for direct screen write.}
{; Get row position and column positions, and offset in screen buffer.}
{;}
/$C4/$3E/>DESQVIEW_SCREEN { LES DI,[>DesqView_Screen] ;Get base address of screen}
/$8B/$4E/<Y { MOV CX,[BP+<Y] ;CX = Row}
/$49 { DEC CX ;Row to 0..Max_Screen_Line-1 range}
/$A1/>MAX_SCREEN_COL { MOV AX,[>Max_Screen_Col] ;Physical screen width}
/$F7/$E1 { MUL CX ;Row * Max_Screen_Col}
/$8B/$5E/<X { MOV BX,[BP+<X] ;BX = Column}
/$4B { DEC BX ;Col to 0..Max_Screen_Col-1 range}
/$01/$D8 { ADD AX,BX ;AX = (Row * Max_Screen_Col) + Col}
/$D1/$E0 { SHL AX,1 ;Account for attribute bytes}
/$89/$FB { MOV BX,DI ;Get base offset of screen}
/$01/$C3 { ADD BX,AX ;Add computed offset}
/$89/$DF { MOV DI,BX ;Move result into DI}
/$8D/$76/<S { LEA SI,[BP+<S] ;DS:SI will point to S[0]}
/$A0/>WAIT_FOR_RETRACE { MOV AL,[<Wait_For_Retrace] ;Grab this before changing DS}
/$8C/$D2 { MOV DX,SS ;Move SS...}
/$8E/$DA { MOV DS,DX ; into DS}
/$8A/$0C { MOV CL,[SI] ;CL = Length(S)}
/$E3/$70 { JCXZ Exit ;If string empty, Exit}
/$46 { INC SI ;DS:SI points to S[1]}
/$8A/$66/<COLOR { MOV AH,[BP+<Color] ;AH = Attribute}
/$FC { CLD ;Set direction to forward}
/$D0/$D8 { RCR AL,1 ;If we don't wait for retrace, ...}
/$73/$1A { JNC Mono ; use "Mono" routine}
{;}
{; Color routine (used only when RetraceMode is True) **}
{;}
/$BA/>CRT_STATUS { MOV DX,>CRT_Status ;Point DX to CGA status port}
/$AC {GetNext: LODSB ;Load next character into AL}
{ ; AH already has Attr}
/$89/$C3 { MOV BX,AX ;Store video word in BX}
{;}
/$EC {WaitNoH: IN AL,DX ;Get 6845 status}
/$A8/$01 { TEST AL,1 ;Wait for horizontal}
/$75/$FB { JNZ WaitNoH ; retrace to finish}
{;}
/$FA { CLI ;Turn off interrupts}
/$EC {WaitH: IN AL,DX ;Get 6845 status again}
/$A8/$01 { TEST AL,1 ;Wait for horizontal retrace}
/$74/$FB { JZ WaitH ; to start}
{;}
/$89/$D8 {Store: MOV AX,BX ;Restore attribute}
/$AB { STOSW ; and then to screen}
/$FB { STI ;Allow interrupts}
/$E2/$EC { LOOP GetNext ;Get next character}
/$E9/$4D/$00 { JMP Exit ;Done}
{;}
{; Mono routine (used whenever Wait_For_Retrace is False) **}
{;}
/$AC {Mono: LODSB ;Load next character into AL}
{ ; AH already has Attr}
/$AB { STOSW ;Move video word into place}
/$E2/$FC { LOOP Mono ;Get next character}
{;}
/$E9/$46/$00 { JMP Exit ;Done}
{;}
{; Use BIOS to display string (if Write_Screen is False) **}
{;}
/$8A/$76/<Y {Bios: MOV DH,[BP+<Y] ;Get starting row}
/$FE/$CE { DEC DH ;Drop by one for BIOS}
/$8A/$56/<X { MOV DL,[BP+<X] ;Get starting column}
/$FE/$CA { DEC DL ;Drop for indexing}
/$FE/$CA { DEC DL ;}
/$8D/$76/<S { LEA SI,[BP+<S] ;DS:SI will point to S[0]}
/$8C/$D0 { MOV AX,SS ;Move SS...}
/$8E/$D8 { MOV DS,AX ; into DS}
/$31/$C9 { XOR CX,CX ;Clear out CX}
/$8A/$0C { MOV CL,[SI] ;CL = Length(S)}
/$E3/$2D { JCXZ Exit ;If string empty, Exit}
/$46 { INC SI ;DS:SI points to S[1]}
/$52 { PUSH DX ;Save X and Y}
/$1E { PUSH DS ;Save string address}
/$56 { PUSH SI ;}
/$FC { CLD ;Forward direction}
{;}
/$B4/$02 {Bios1: MOV AH,2 ;BIOS Position cursor}
/$B7/$00 { MOV BH,0 ;Page zero}
/$5E { POP SI ;Get S address}
/$1F { POP DS ;}
/$5A { POP DX ;X and Y}
/$FE/$C2 { INC DL ;X + 1}
/$52 { PUSH DX ;Save X and Y}
/$1E { PUSH DS ;Save strin address}
/$56 { PUSH SI}
/$51 { PUSH CX ;Push length}
/$CD/$10 { INT $10 ;Call BIOS to move to (X,Y)}
/$59 { POP CX ;Get back length}
/$5E { POP SI ;Get String address}
/$1F { POP DS ;}
/$AC { LODSB ;Next character into AL}
/$1E { PUSH DS ;Save String address}
/$56 { PUSH SI ;}
/$51 { PUSH CX ;Length left to do}
/$B4/$09 { MOV AH,9 ;BIOS Display character}
/$B7/$00 { MOV BH,0 ;Display page zero}
/$8A/$5E/<COLOR { MOV BL,[BP+<Color] ;BL = Attribute}
/$B9/$01/$00 { MOV CX,1 ;One character}
/$CD/$10 { INT $10 ;Call BIOS}
/$59 { POP CX ;Get back length}
/$E2/$DB { LOOP Bios1}
{; ;Remove stuff left on stack}
/$5E { POP SI}
/$1F { POP DS}
/$5A { POP DX}
{;}
/$1F {Exit: POP DS ;Restore DS}
);
(* Unfreeze screen in DoubleDos *)
IF ( MultiTasker = DoubleDos ) THEN
TurnOnTimeSharing
(* Synchronize screen for TopView *)
ELSE IF ( MultiTasker = TopView ) THEN
Sync_Screen( ( ( Y - 1 ) * Max_Screen_Col + X ) SHL 1 - 1 , ORD( S[0] ) );
END (* WriteSXY *);
(*----------------------------------------------------------------------*)
(* WriteTTY --- Write character to screen using BIOS write TTY *)
(*----------------------------------------------------------------------*)
PROCEDURE WriteTTY( C: CHAR; Color: INTEGER );
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: WriteTTY *)
(* *)
(* Purpose: Writes a character to screen using BIOS write TTY *)
(* *)
(* Calling Sequence: *)
(* *)
(* WriteTTY( C: CHAR; Color: INTEGER ); *)
(* *)
(* C --- Character to be written *)
(* Color --- Color in which to write character *)
(* *)
(* Calls: BIOS *)
(* *)
(*----------------------------------------------------------------------*)
BEGIN (* WriteTTY *)
INLINE(
$B4/$09 { MOV Ah,9 ;BIOS display character}
/$8A/$46/$20 { MOV Al,C' ' ;Blank}
/$B7/$00 { MOV BH,0 ;}
/$8A/$5E/$04 { MOV BL,[BP+4] ;Color}
/$B9/$01/$00 { MOV CX,1 ;One character}
/$CD/$10 { INT $10 ;Call BIOS}
/$B4/$0E { MOV Ah,$0E ;BIOS display character}
/$8A/$46/$06 { MOV Al,[BP+6] ;Ch}
/$B7/$00 { MOV BH,0 ;}
/$CD/$10 { INT $10 ;Call BIOS}
);
END (* WriteTTY *);
(*----------------------------------------------------------------------*)
(* Set_Graphics_Colors --- Set colors for graphics mode *)
(*----------------------------------------------------------------------*)
PROCEDURE Set_Graphics_Colors( EGA_On : BOOLEAN;
GMode : INTEGER;
FG : INTEGER;
BG : INTEGER );
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Set_Graphics_Colors *)
(* *)
(* Purpose: Sets colors for graphics modes *)
(* *)
(* Calling Sequence: *)
(* *)
(* Set_Graphics_Colors( EGA_On: BOOLEAN; GMode: INTEGER; *)
(* FG : INTEGER; BG : INTEGER ); *)
(* *)
(* EGA_On --- TRUE if EGA installed *)
(* GMode --- Graphics mode to set *)
(* FG --- Foreground color *)
(* BG --- Background color *)
(* *)
(*----------------------------------------------------------------------*)
VAR
Regs: RegPack;
BEGIN (* Set_Graphics_Colors *)
(* Request 640x200 graphics mode *)
IF EGA_On THEN
BEGIN (* Set up EGA mode *)
WITH Regs DO
BEGIN
Regs.Ah := 0;
Regs.Al := GMode;
INTR( $10, Regs );
END;
(* Set graphics border color *)
WITH Regs DO
BEGIN
Regs.Ah := 16;
Regs.Al := 01;
Regs.Bh := BG;
Regs.Bl := 0;
INTR( $10, Regs );
END;
(* Set graphics foreground color *)
WITH Regs DO
BEGIN
Regs.Ah := 16;
Regs.Al := 00;
Regs.Bh := FG;
Regs.Bl := 1;
INTR( $10, Regs );
END;
(* Set graphics background color *)
WITH Regs DO
BEGIN
Regs.Ah := 16;
Regs.Al := 00;
Regs.Bh := BG;
Regs.Bl := 0;
INTR( $10, Regs );
END;
(* Set foreground intensity *)
IF ( FG > 7 ) THEN
WITH Regs DO
BEGIN
Regs.Ah := 16;
Regs.Al := 03;
Regs.Bh := FG;
Regs.Bl := 0;
INTR( $10, Regs );
END;
END (* Set up EGA mode *)
ELSE
BEGIN (* Set up CGA mode *)
WITH Regs DO
BEGIN
Regs.Ah := 0;
Regs.Al := GMode;
INTR( $10, Regs );
END;
GraphBackGround( FG );
END (* Set up CGA mode *);
END (* Set_Graphics_Colors *);